.@VERSION = 3.029T{ ۞XNƼ\ DOUBLEshapeshapewizshape;Height = 68 Width = 68 wizeffect = 0 Name = "wizshape" Class1 wizeffect Pixels container container layoutstyWidth = 517 Height = 205 TabIndex = 0 odimensions = Shape1 olabel1 = Shape2 olabel2 = Shape3 ocol2 = Shape4 Name = "layoutsty" ClassRA:d@ STݰ_7HPOPEN5&odimensions olabel1 olabel2 ocol2 stylebmp\layout.bmpstylebmp\layout.bmpPixelsshapeshapeShape1 layoutsty?Height = 205 Left = 0 Top = 0 Width = 517 Name = "Shape1" shapeshapeShape2 layoutsty?Height = 13 Left = 24 Top = 24 Width = 37 Name = "Shape2" shapeshapeShape3 layoutsty?Height = 13 Left = 24 Top = 45 Width = 37 Name = "Shape3" shapeshapeShape4 layoutsty@Height = 13 Left = 228 Top = 24 Width = 37 Name = "Shape4" !Arial, 0, 9, 5, 15, 12, 32, 3, 0 baseformPixelsstylebmp\form.bmpstylebmp\form.bmpClass1formbaseformwizlayout Class reference for layout object. wizfield Class reference for a field object. wizmemo Class reference for a memo field object. wizlogic Class reference for a logic field object. wizole Class reference for a general field object. wizmaxcharfld Max width of character field before using editbox memo object. wizlblsuffix Character expression added to the end of each label (e.g., :). wizlblcap Label capitalization (proper, normal, upper or lower). wizformstretch Whether to shrink/expand form (height only) based on number of fields selected. wizlbldefwid Whether to use fixed label width for consistent look and alignment of fields on form. wiztitle Class reference for title object (label). wizuser For use by user. wizgrid Class reference for grid object with 1-Many forms. wizverify Whether to verify class objects (use for testing but can improve performance if set .F.). wizbuttons Class reference for button set object. wizbtnpos Button position centering (0-none, 1-hori, 2-vert, 3-both). By default, buttons are centered in footer. You can use these settings for better control over how buttons are placed, especially if buttons are vertically laid out. wizcodestyle Whether to use code style or button style. wizbtnlayout Button position object (class) if one used for unique placement of buttons. wizcaptions Whether to use DBC long name label captions. wizbuffering Data environment table buffering setting. wizgridform Whether to use a separate form for grid object. wizlabel Class reference for label object. wizlblspace Space between label and field. wizcboxlbl Whether to use the checkbox as the label. wizpages Allows use of pages for overflow of fields (0 - none, 1 - single column, 2 - multi column). wizpagestyle This is style class for page frame. wizappclass Name of application class to add to form. wizappclasslibrary Name of application class library to add to form. wizappobject Name used on form for application class. lshowfirsttime haderror Whether an error occurred. lpromptkey Whether to prompt for primary key value. lsavebuffereddata lupdateallbufferedtables *pickrecord *addrecord *resolveconflicts *deleterecord   % HU/%CTHIS.APP_MEDIATOR.BaseClassbC3B%C%CC  C%CCN  CUTHIS APP_MEDIATORPICKRECORDTOWORKONLADDINGREFRESH ADDRECORD %C+C 6#) TCO HS C WIZBTNS.VCX0T WIZBTNS.VCX* CCQWIZARDS\ WIZBTNS.VCX0(TCQWIZARDS\ WIZBTNS.VCX2 T HF C SourceTypeCoffline C SendUpdates [COYou cannot add a new record because the view(s) selected does not send updates.xB- CCdatabaseꉡ C SourceType( C buffering  C(2TCDATABASEvG(Cdatabase2TCC sourcenameTable PrimaryKeyTC WSET DATABASE TO &lcSaveData %C  TC mTC AddRecordTCcustomNT  T C T  C % rC  Ta%T- #B- CU LNSAVEREC LCSAVEDATALOADDRECLOCUSTOM CPRIMARYKEY LCCLASSLIB NPRIMARYKEYTHIS LPROMPTKEY CKEYFIELD CKEYVALUE ORETVALUESHOW NBTNACTIONHADERRORTHISFORMREFRESH% B   x%CTHIS.ActiveControl.baseclassbCC valueh C controlsourceh C  T  %C  T   T  T T  HE, CTHISFORM.DataEnvironmentbOTCb%TTHISFORM.DataEnvironment/ CTHISFORMSET.DataEnvironmentbO#TCb(TTHISFORMSET.DataEnvironment ETCy2%CC {TC T ( %C TC !!C .C %CCURSOR .TD%CC sourcetype C buffering %  } %C buffering%C.TC%C1C>QC_.IT C6Data has been changed. Would you like to save changes?#x% \B-T  Ta% Caa CaUTHISLSAVEBUFFEREDDATA NDECURSORS ADECURSORS CDATAENVREF LPROMPTSAVE LHADPROMPTLCALIASLNFIELDS NPROMPTSAVEILOCURRENTCONTROL ACTIVECONTROL CONTROLSOURCEVALUETHISFORMDATAENVIRONMENT THISFORMSETLUPDATEALLBUFFEREDTABLES BASECLASSALIAS T- %C #B9%C"Do you want to delete this record?$x+C'C+  %C+ %!#) TaH %t,ULLHADEOFTHISFORMREFRESH SHOWWINDOWNAME B UTHISHADERROR/%CTHIS.APP_MEDIATOR.BaseClassbCT%C LB-B %C%C B-B-UTHISRESOLVECONFLICTS APP_MEDIATOR QUERYUNLOAD|:%CTHIS.APP_MEDIATOR.BaseClassbC LBT-T- CUNSTYLELCAPPREFTHISLSHOWFIRSTTIMELSAVEBUFFEREDDATA PICKRECORD  TCzTa HT- CkB$ C CCxB  %C+#6#)B \%C bufferingF6C*A unique key error violation has occurred.xBk%C*A unique key error violation has occurred. !Would you like to revert changes?$x CaB -PCDError: Table is in use. The table may already be opened exclusively.xBZCCEC Error: CZC CEC Method: C Line: CZxUNERRORCMETHODNLINEAFOXERRNTOTERRTHISHADERROR$%C B-UTHIS QUERYUNLOAD pickrecord, addrecord#resolveconflicts deleterecord Load QueryUnload Show ErrorReleasee1AABAAA3"QAAcqRRRSqa!!Qa!AAAAAqA3AArq1AAQ!!AAAAAAACqAAAAAAqA!AAAA3tAAA1AAQAAAABA33!AqAAAQAqAAqA3qqAA3!1AA2AQQAA!aAAAA!AA3!AqA2P ppD+YNe?]")PROCEDURE pickrecord IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C" RETURN ENDIF IF THIS.APP_MEDIATOR.PickRecordToWorkOn() IF THIS.APP_MEDIATOR.lAdding AND !EMPTY(ALIAS()) THIS.REFRESH() * Check if we have blank record already from txtbtns IF GETFLDSTATE(1)#3 OR RECCOUNT()=0 THIS.AddRecord() ENDIF ENDIF ENDIF ENDPROC PROCEDURE addrecord #DEFINE C_NOUPDATE_LOC "You cannot add a new record because the view(s) selected does not send updates." #DEFINE DIALOG_CLASSLIB "WIZBTNS.VCX" LOCAL lnSaveRec,lcSaveData,loAddRec,loCustom,cPrimaryKey,lcClassLib,nPrimaryKey IF EOF() OR BOF() GO TOP ENDIF lnSaveRec = RECNO() DO CASE CASE FILE(DIALOG_CLASSLIB) lcClassLib = DIALOG_CLASSLIB CASE FILE(HOME()+"WIZARDS\"+DIALOG_CLASSLIB) lcClassLib = HOME()+"WIZARDS\"+DIALOG_CLASSLIB OTHERWISE lcClassLib = "" ENDCASE DO CASE CASE CURSORGETPROP("SourceType")#3 AND ; !CURSORGETPROP("offline") AND ; !CURSORGETPROP("SendUpdates") MESSAGEBOX(C_NOUPDATE_LOC) RETURN .F. CASE EMPTY(CURSORGETPROP("database")) * Free table APPEND BLANK CASE CURSORGETPROP("SourceType")#3 * View APPEND BLANK CASE CURSORGETPROP("buffering")#1 AND !THIS.lPromptKey * buffered data APPEND BLANK CASE EMPTY(lcClassLib) * could disable this if you feel * potential unique ID conflicts could arise APPEND BLANK OTHERWISE lcSaveData = SET("DATABASE") SET DATABASE TO CURSORGETPROP("database") cPrimaryKey = DBGETPROP(CURSORGETPROP("sourcename"),"Table","PrimaryKey") nPrimaryKey = TAGNO(m.cPrimaryKey) SET DATABASE TO &lcSaveData IF EMPTY(cPrimaryKey) OR m.nPrimaryKey=0 APPEND BLANK ELSE cPrimaryKey=KEY(m.nPrimaryKey) loAddRec=NewObject("AddRecord",lcClassLib,"") loCustom = Create('custom') loAddRec.cKeyField = m.cPrimaryKey loAddRec.cKeyValue = EVAL(m.cPrimaryKey) loAddRec.oRetValue = loCustom loAddRec.Show() IF loCustom.nBtnAction=1 INSERT INTO (ALIAS()) ((m.cPrimaryKey)) VALUES(loCustom.cKeyValue) ELSE THIS.HadError = .T. ENDIF ENDIF ENDCASE IF THIS.HadError THIS.HadError = .F. GO lnSaveRec RETURN .F. ENDIF THISFORM.Refresh() ENDPROC PROCEDURE resolveconflicts #DEFINE PROMPTTOSAVE_LOC "Data has been changed. Would you like to save changes?" IF !THIS.lSaveBufferedData RETURN ENDIF LOCAL nDECursors, aDECursors, cDataEnvRef, lPromptSave,lHadPrompt LOCAL lcAlias, lnFields, nPromptSave, i, loCurrentControl * Flush current control IF TYPE("THIS.ActiveControl.baseclass")="C" AND; PEMSTATUS(THIS.ActiveControl,"value",5) AND; PEMSTATUS(THIS.ActiveControl,"controlsource",5) AND; !EMPTY(THIS.ActiveControl.controlsource) loCurrentControl = THIS.ActiveControl * Check if data actually changed IF !EVAL(loCurrentControl.controlsource)= loCurrentControl.Value loCurrentControl.Value = loCurrentControl.Value ENDIF loCurrentControl="" ENDIF nDECursors = 0 cDataEnvRef = "" DIMENSION aDECursors[1] DO CASE CASE TYPE("THISFORM.DataEnvironment") = "O" nDECursors = AMEMBERS(aDECursors,THISFORM.DataEnvironment,2) cDataEnvRef = "THISFORM.DataEnvironment" CASE TYPE("THISFORMSET.DataEnvironment") = "O" nDECursors = AMEMBERS(aDECursors,THISFORMSET.DataEnvironment,2) cDataEnvRef = "THISFORMSET.DataEnvironment" CASE THIS.lUpdateAllBufferedTables nDECursors=AUSED(aDECursors) OTHERWISE IF !EMPTY(ALIAS()) aDECursors[1]=ALIAS() nDECursors=1 ENDIF ENDCASE FOR i = 1 TO m.nDECursors IF EMPTY(m.cDataEnvRef) lcAlias = aDECursors[m.i] ELSE WITH EVAL(m.cDataEnvRef + "." + aDECursors[m.i]) IF ATC("CURSOR",.BaseClass)=0 &&skip relations LOOP ENDIF lcAlias = .ALIAS ENDWITH ENDIF IF USED(lcAlias) AND CursorGetProp("sourcetype",lcAlias )=3 AND ; CursorGetProp("buffering",lcAlias )>1 IF !m.lHadPrompt IF CursorGetProp("buffering",lcAlias )>3 IF GETNEXTMODIFIED(0,lcAlias )=0 LOOP ENDIF ELSE lnFields = GETFLDSTATE(-1,lcAlias) IF REPLICATE("1",LEN(lnFields))=TRANS(lnFields) LOOP ENDIF ENDIF nPromptSave = MESSAGEBOX(PROMPTTOSAVE_LOC,35) IF nPromptSave=2 RETURN .F. ENDIF lPromptSave=(nPromptSave=6) lHadPrompt = .T. ENDIF IF m.lPromptSave TableUpdate(.T.,.T.,lcAlias) && update on exit ELSE TableRevert(.T.,lcAlias) && update on exit ENDIF ENDIF ENDFOR ENDPROC PROCEDURE deleterecord #DEFINE MSGBOX_YES 6 #DEFINE C_MSGBOX1 36 #DEFINE C_DELETE_LOC "Do you want to delete this record?" LOCAL llHadEof llHadEof=.F. * Note: Cascading deletes should be handled via RI triggers in DBC! IF !USED() RETURN ENDIF IF MESSAGEBOX(C_DELETE_LOC,C_MSGBOX1) = MSGBOX_YES DELETE DO WHILE DELETED() OR EOF() IF EOF() IF llHadEof EXIT ENDIF GO TOP llHadEof = .T. ELSE SKIP ENDIF ENDDO THISFORM.Refresh ENDIF IF THISFORM.ShowWindow = 2 Activate Window (THISFORM.Name) ENDIF ENDPROC PROCEDURE Load RETURN !THIS.HadError ENDPROC PROCEDURE QueryUnload IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C" IF !THIS.ResolveConflicts() NODEFAULT RETURN .F. ENDIF RETURN ENDIF IF DODEFAULT() IF NOT THIS.App_Mediator.QueryUnload() NODEFAULT RETURN .F. ENDIF ELSE NODEFAULT RETURN .F. ENDIF ENDPROC PROCEDURE Show LPARAMETERS nStyle LOCAL lcAppRef IF TYPE("THIS.APP_MEDIATOR.BaseClass")#"C" OR !THIS.lShowFirstTime RETURN ENDIF THIS.lShowFirstTime = .F. THIS.lSaveBufferedData = .F. THIS.PickRecord() ENDPROC PROCEDURE Error #DEFINE ERR_UNIQUEKEY_LOC "A unique key error violation has occurred." #DEFINE ERR_UNIQUEKEY2_LOC "Would you like to revert changes?" #DEFINE ERR_TABLEINUSE_LOC "Error: Table is in use. The table may already be opened exclusively." LPARAMETERS nError, cMethod, nLine LOCAL aFoxErr,nTotErr DIMENSION aFoxErr[1] nTotErr = AERROR(aFoxErr) THIS.HadError = .T. DO CASE CASE INLIST(nError,1967) &&errors to skip RETURN CASE nToterr>0 AND aFoxErr[1,1] = 1420 * Corrupt Ole object in General field. MESSAGEBOX(aFoxErr[1,2]) RETURN CASE nError = 5 &&record out of range IF EOF() GO BOTTOM ELSE GO TOP ENDIF RETURN CASE nError = 1884 * Uniqueness ID error IF CURSORGETPROP("buffering")=1 MESSAGEBOX(ERR_UNIQUEKEY_LOC) RETURN ENDIF IF MESSAGEBOX(ERR_UNIQUEKEY_LOC+" "+ERR_UNIQUEKEY2_LOC,36)=6 TABLEREVERT(.T.) ENDIF RETURN CASE nError = 1995 &&table is in use MESSAGEBOX(ERR_TABLEINUSE_LOC) RETURN ENDCASE **** Error Dialog ****** MESSAGEBOX(MESSAGE(1)+CHR(13)+; "Error: "+STR(nError)+CHR(13)+; MESSAGE()+CHR(13)+; "Method: "+cMethod+CHR(13)+; "Line: "+STR(nLine)) ENDPROC PROCEDURE Release IF !THIS.Queryunload() NODEFAULT RETURN .F. ENDIF ENDPROC DataSession = 2 ScaleMode = 3 Height = 320 Width = 580 ShowWindow = 1 ScrollBars = 3 DoCreate = .T. AutoCenter = .T. Caption = "Form1" Enabled = .T. wizlayout = wizfield = wizmemo = wizlogic = 0 wizole = wizmaxcharfld = 0 wizlblsuffix = 0 wizlblcap = 0 wizformstretch = 0 wizlbldefwid = 0 wiztitle = wizuser = 0 wizgrid = wizverify = 0 wizbuttons = 0 wizbtnpos = 0 wizcodestyle = 0 wizbtnlayout = 0 wizcaptions = .T. wizbuffering = 5 wizlabel = wizlblspace = 0 wizpages = 1 wizpagestyle = wizappclass = _formmediator wizappclasslibrary = _framewk.vcx wizappobject = app_mediator lshowfirsttime = .T. lpromptkey = .T. lsavebuffereddata = .T. Name = "baseform" form